home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / casterli.arc / DLIST.4TH < prev    next >
Text File  |  1986-04-26  |  3KB  |  27 lines

  1. ( Printing and Listing Words - Screen 1 )
  2.  
  3. 0 VARIABLE SCREENCOUNT
  4. 0 VARIABLE PFLAG
  5.  
  6.  
  7. : PRON PON 1 PFLAG ! ;     ( Turns printer on, sets flag )
  8. : PROFF POFF 0 PFLAG ! ;    ( Turns printer off, resets flag )
  9.  
  10. : LISTSCRNS CR 1+ SWAP 2DUP ( START END --- )
  11.   ." Screens " . ." thru " 1- .
  12.   CR 0 SCREENCOUNT ! DO 1 SCREENCOUNT +! I LIST SCREENCOUNT
  13.   @ 3 = IF 0 SCREENCOUNT ! 12 EMIT THEN LOOP 12 EMIT ;
  14.   ( Lists consecutive screens from START to END )
  15.                                                             -->
  16.  
  17. ( Printing and Listing Words - Screen 2 )
  18. ( These words are part of the definition for DLIST )
  19.  
  20. 0 VARIABLE CHAR?  ( Holds character to search for )
  21. 0 VARIABLE #PRTED ( Number of words on current output line )
  22.  
  23. : 1STCHAR ( NFA --- NFA ASCII )
  24.   DUP 1+ C@ ;  ( Gets 1st letter of name field )
  25.  
  26. : GETCHAR BL WORD HERE 1+ C@ DUP 0= IF CR CR
  27.   ." DLIST requir                                                                                                                             -->( Stack Words - Screen 2 )                                                                                                      : .P CR DEPTH 0= IF ." .P: Stack Empty.  " CR QUIT THEN           ." (Top) " DEPTH 1+ 1 DO I PICK . LOOP ." (Bottom) " CR SP!     ." The stack has been emptied. " CR ;                           ( Does a [signed] stack print, then clears stack )                                                                                                                                            : S. CR DEPTH 0= IF ." S.: Stack Empty. " CR QUIT THEN            ." (Top) " DEPTH 1+ 1 DO I PICK . LOOP ." (Bottom) " CR ;       ( Does a [signed] stack print without clearing stack )                                                                                                                                                                                                                                                                                                                                     -->( Stack Words - Screen 3 )                                                                                                      ( : USPLIT DUP DUP 0 256 U/ SWAP DROP 256 U* DROP -   )         ( SWAP 0 256 U/ SWAP DROP SWAP ;                      )           ( U --- MSB LSB ) ( Unsigned number replaced by MSB & LSB )     ( NEED A U/ DEF TO MAKE THIS WORK WITH MVPFORTH! )                                                                            : UJOIN SWAP 256 * + ;                                            ( MSB LSB --- U ) ( MSB & LSB replaced by unsigned number )                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                  üα  └tδδ\╕ëF¼ïFëFⁿïvⁿ Fⁿèüα PΦ╘µâ─ïv■ F■êüα â°\uδïF¼ └t N¼δ N■δ╔ïF■ìV░â┬C;╨sΘ█ïFⁿëFΘm ïF■ìV░â┬;╨s N■╕ïv■ê